Personal Computer World 2005 October/PCWOCT05.iso/Software/FromTheMag/Syn Text Editor 2.1.0.46/synsetup-2.1.0.46.exe/{app}/scripts/cvs.vbs

Text File | 2003-08-13 | 8.3 KB | 299 lines

' Caption: CVS|
' Hint: Do some CVS actions|
' Icon: cvs.ico|
'
'  syn
'  Copyright (C) 2000-2003, Ascher Stefan. All rights reserved.
'  [e-mail], http://web.utanet.at/ascherst/
'
'  The contents of this file are subject to the Mozilla Public License
'  Version 1.1 (the "License"); you may not use this file except in compliance
'  with the License. You may obtain a copy of the License at
'  http://www.mozilla.org/MPL/
'
'  Software distributed under the License is distributed on an "AS IS" basis,
'  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
'  the specific language governing rights and limitations under the License.
'
'  The Original Code is cvs.vbs, released Sun, 28 Jul 2002 14:06:54 UTC.
'
'  The Initial Developer of the Original Code is Ascher Stefan.
'  Portions created by Ascher Stefan are Copyright (C) 2000-2003 Ascher Stefan.
'  All Rights Reserved.
'
'  Contributor(s): .
'
'  Alternatively, the contents of this file may be used under the terms of the
'  GNU General Public License Version 2 or later (the "GPL"), in which case
'  the provisions of the GPL are applicable instead of those above.
'  If you wish to allow use of your version of this file only under the terms
'  of the GPL and not to allow others to use your version of this file
'  under the MPL, indicate your decision by deleting the provisions above and
'  replace them with the notice and other provisions required by the GPL.
'  If you do not delete the provisions above, a recipient may use your version
'  of this file under either the MPL or the GPL.
'
'  You may retrieve the latest version of this file at the syn home page,
'  located at http://syn.sourceforge.net/
'
' $Id: cvs.vbs,v 1.8.2.5 2003/08/13 00:38:45 neum Exp $
'

' This Script should provide a *very* simple integration from CVS (Concurrent
' Version System), and it's in a very exerimental state. It seems to work with
' local repositories, and with the server from SourceForge.

' ScriptEngine=VBScript

option explicit

' Remove the dot to include this file(s)
'#include <consts>
'#include <cmnfunc>
const RegKey = "HKCU\Software\Ascher\syn\Macros"

dim okbutton
dim cancelbutton
dim msgmemo
dim cleancopy

sub MemoEnter(Sender)
  okbutton.Default = false
end sub
sub MemoExit(Sender)
  okbutton.Default = true
end sub
sub ComboClick(Sender)
  msgmemo.Enabled = (Sender.ItemIndex = 1)
  if msgmemo.Enabled then
    msgmemo.Color = 5 or &h80000000     ' clWindow
  else
    msgmemo.Color = 15 or &h80000000    ' clBtnFace
  end if
  cleancopy.Enabled = (Sender.ItemIndex = 0)
end sub

sub Main(FileName)
  if (Documents.Count = 0) then
    MsgBox "There is currently no file open.", vbCritical
    exit sub
  end if
  if not CheckSave then
    exit sub
  end if

  dim form
  form = Create("TForm", Self)
  with form
    .Caption = "CVS"
    .Position = "poOwnerFormCenter"
    .BorderStyle = "bsDialog"
    .Height = 400
    .Width = 350
  end with
  dim cbo
  cbo = Create("TComboBox", Self)
  with cbo
    .Parent = form
    .Top = 20
    .Left = 5
    .Width = form.ClientWidth - 10
    .Style = "csDropDownList"
    .Items.Add "Update"
    .Items.Add "Commit"
    .Items.Add "Add"
    .Items.Add "Remove"
    .Items.Add "Diff"
    .ItemIndex = 0
    .OnClick = "ComboClick"
  end with
  with Create("TLabel", Self)
    .Parent = form
    .Caption = "&Do what:"
    .Top = cbo.Top - 15
    .Left = 5
    .FocusControl = cbo
  end with

  dim list
  dim rootdir
  dim ii

  rootdir = AddBackSlash(ExtractFilePath(ActiveDocument.FileName))

  dim cvsroot
  dim rootfile
  dim reposfile
  dim repository
  rootfile = AddBackSlash(rootdir) & "CVS\Root"
  if FileExists(rootfile) then
    cvsroot = FileReadLine(rootfile, 0)
  end if
  reposfile = AddBackSlash(rootdir) & "CVS\Repository"
  if FileExists(reposfile) then
    repository = FileReadLine(reposfile, 0)
  end if

  ii = InStr(1, repository, "/")
  if ii > 0 then
    repository = Mid(repository, ii, Len(repository) - ii)
    rootdir = Mid(rootdir, 1, Len(rootdir) - Len(repository) - 1)
  end if

  list = Create("TCheckListBox", Self)
  with list
    .Parent = form
    .Left = 5
    .Top = 60
    .Height = form.ClientHeight - 250
    .Width = form.ClientWidth - 10
    dim i, j
    for i = 0 to Documents.Count - 1
      if Documents(i).FileName <> "" then
        if InStr(1, Documents(i).FileName, rootdir) > 0 then
          j = .Items.Add(Mid(Documents(i).FileName, Len(rootdir) + 1))
          .Checked(j) = true
        end if
      end if
    next
  end with

  with Create("TLabel", Self)
    .Parent = form
    .Caption = "&Select files:"
    .Top = list.Top - 15
    .Left = 5
    .FocusControl = list
  end with
  msgmemo = Create("TMemo", Self)
  with msgmemo
    .Parent = form
    .Top = list.Top + list.Height + 20
    .Left = 5
    .Height = form.ClientHeight - .Top - 80
    .Width = form.ClientWidth - 10
    .ScrollBars = "ssVertical"
    .WantReturns = true
    .WantTabs = false
    .OnEnter = "MemoEnter"
    .OnExit = "MemoExit"
    .Enabled = false
    .Color = 15 or &h80000000
  end with
  with Create("TLabel", Self)
    .Parent = form
    .Caption = "&Message:"
    .Top = msgmemo.Top - 15
    .Left = 5
    .FocusControl = msgmemo
  end with

  dim compress
  compress = Create("TSpinEdit", Self)
  with compress
    .Parent = form
    .Top = msgmemo.Top + msgmemo.Height + 20
    .Left = 5
    .ShowHint = true
    .Hint = "0 = no compression"
    .MinValue = 0
    .MaxValue = 9
    .Value = RegGetSettings(AddBackslash(RegKey) & "cvs_compression", 3)
  end with
  with Create("TLabel", Self)
    .Parent = form
    .Caption = "&Compression:"
    .Top = compress.Top - 15
    .Left = 5
    .FocusControl = compress
  end with

  cleancopy = Create("TCheckBox", Self)
  with cleancopy
    .Parent = form
    .Caption = "&Get clean copy"
    .Top = msgmemo.Top + msgmemo.Height + 20
    .Left = 150
  end with

  okbutton = Create("TButton", Self)
  with okbutton
    .Parent = form
    .Caption = "OK"
    .Default = true
    .Left = form.ClientWidth - (.Width + 5) * 2
    .Top = form.ClientHeight - .Height - 5
    .ModalResult = mrOK
  end with
  cancelbutton = Create("TButton", Self)
  with cancelbutton
    .Parent = form
    .Caption = "Cancel"
    .Cancel = true
    .Left = form.ClientWidth - .Width - 5
    .Top = form.ClientHeight - .Height - 5
    .ModalResult = mrCancel
  end with

  if (cvsroot = "") or (repository = "") then
    MsgBox "One or more of the following files does not exist:" & vbCrLf & rootfile & vbCrLf & reposfile, vbCritical
  else
    if form.ShowModal = mrOK then

      SetEnv "CVSROOT", cvsroot
      if InStr(1, cvsroot, ":ext:") > 0 then
        SetEnv "CVS_RSH", "ssh"
      elseif InStr(1, cvsroot, ":pserver:") > 0 then
        SetEnv "CVS_RSH", ""       ' <- ???
      elseif InStr(1, cvsroot, ":local:") > 0 then
        SetEnv "CVS_RSH", ""
      end if

      dim msg, files
      if msgmemo.Lines.Text = "" then
        msg = AddQuotes("No message")
      else
        msg = AddQuotesUnless(Replace(msgmemo.Lines.Text, vbCrLf, "\n"))
      end if

      for j = 0 to list.Items.Count - 1
        if list.Checked(j) then
          files = files & " " & AddQuotesUnless(list.Items(j))
        end if
      next
      if files <> "" then

        dim comp
        if compress.Value > 0 then comp = "-z" & CStr(compress.Value) & " "
        if (compress.Value <= 9) and (compress.Value >= 0) then
          RegSetSettings AddBackslash(RegKey) & "cvs_compression", compress.Value
        end if

        dim args
        select case cbo.ItemIndex
        case 0
          if cleancopy.Checked then
            args = comp & "update -dPC" & files
          else
            args = comp & "update -dP" & files
          end if
        case 1
          args = comp & "commit" & " -m " & msg & files
        case 2
          args = comp & "add" & files
        case 3
          args = comp & "remove" & files
        case 4
          args = comp & "diff" & files
        end select
      end if
      dim pdir
      pdir = CurDir
      CurDir = rootdir
      Execute "cvs " & args, 1, false
      CurDir = pdir
    end if
  end if
  form.Free
end sub